home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / cardex.arc / CARDEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-26  |  54.2 KB  |  1,779 lines
  1. (************************************************************************)
  2.  
  3. PROGRAM CARDEX (INPUT, OUTPUT) ;
  4.  
  5. (*************************************************************************
  6.  
  7. SOURCE FILE        - CARDEX.PAS
  8.  
  9. OBJECT FILE        - CARDEX.COM
  10.  
  11. DATA FILE          - As per CARDEX.CFG or User Specified or
  12.                      default (CARDEX.DAT)
  13.  
  14. CONFIGURATION FILE - CARDEX.CFG
  15.                      Specifies data file default and Mono/Color monitor
  16.  
  17. THE PROGRAM IS A MEMORY HELD CARD INDEX ACCESSED VIA POINTER VARIABLES.
  18.  
  19.               WRITTEN BY AND PROPERTY OF MARK L. CARSON
  20.  
  21. STARTED 7 JULY 1985                             VERSION 1.2 -  1 MAY 1986
  22.  
  23. *************************************************************************)
  24.  
  25. CONST
  26.      CompileDate = ' 1 MAY 86' ;
  27.      Version     = '1.2'       ;
  28.      NbrOfFields = 15          ;
  29.      LineLen     = 54          ;
  30.      Blank   = '                                                       ' ;
  31.      Blank2  = '  ' ;
  32.      Blank3  = '   ' ;
  33.      Blank4  = '    ' ;
  34.      Blank5  = '     ' ;
  35.      Blank15 = '               ' ;
  36.      Blank19 = '                   ' ;
  37.      Blank26 = '                          ' ;
  38.      Blank54 = '                                                       ' ;
  39.  
  40. TYPE
  41.     DataRecord = ^Node      ;
  42.     String19   = STRING[19] ;
  43.     String54   = STRING[54] ;
  44.     String12   = STRING[12] ;
  45.     KeyType    = (Regular, Return, Backspace, Escape, Cursor, F1) ;
  46.     CursorType = (Home, Up, Left, Right, EndKey, Down) ;
  47.     StringLen  = STRING[LineLen] ;
  48.  
  49.     UNIT = RECORD
  50.            Last   : String19   ;            (* Last name       *)
  51.            First  : STRING[15] ;            (* First name      *)
  52.            Area   : STRING[3]  ;            (* Area code       *)
  53.            Fone1  : STRING[3]  ;            (* Phone Exchange  *)
  54.            Fone2  : STRING[4]  ;            (* Last 4 digits   *)
  55.            Addr   : STRING[54] ;            (* Street address  *)
  56.            City   : STRING[26] ;            (* City name       *)
  57.            State  : STRING[2]  ;            (* 2 letter state  *)
  58.            ZIP    : STRING[5]  ;            (* 5 digit ZIP     *)
  59.            ExtZIP : STRING[4]  ;            (* Extended ZIP    *)
  60.            L : ARRAY[1..5] OF STRING[54] ;  (* Additional info *)
  61.            END ;
  62.  
  63.     Node = RECORD
  64.            PrevNode,
  65.            NextNode : DataRecord ;
  66.            CARD : UNIT ;
  67.            END ;
  68.  
  69.     Coordinate = RECORD
  70.            X, Y : INTEGER ;
  71.            END ;
  72.  
  73.     FieldRec = RECORD
  74.            X   : 1..54      ;      { column number  }
  75.            Y   : 1..25      ;      { line number    }
  76.            Len : 0..54      ;      { field length   }
  77.            Str : String[54] ;      { field's string }
  78.            END ;
  79.  
  80. VAR
  81.    TempLast        : String19          ;
  82.    Ch, Ch2         : CHAR              ;
  83.    Pos             : 1..LineLen        ;
  84.    Key             : KeyType           ;
  85.    CursorDir       : CursorType        ;
  86.    Esc, FunctionKey,
  87.    Abort, Changed,
  88.    BadKey, LoadFailed,
  89.    JustStarted,
  90.    InitialConfig,
  91.    EntryGotoCard          : BOOLEAN ;
  92.    Monitor, Inkey,
  93.    CharIn, Select,
  94.    FormFeed               : CHAR ;
  95.    Top, Bottom,
  96.    Counter, Nbr, Blue,
  97.    Green, Grn, Red,
  98.    Yellow, Blu, Dim       : INTEGER ;
  99.    FldNbr                 : 1..15 ;
  100.    DefaultArea            : STRING[3] ;
  101.    Copyright              : STRING[27] ;
  102.    Access                 : STRING[28] ;
  103.    InfoLine               : STRING[80] ;
  104.    DataFile, ConfigFile,
  105.    DiskFile, MarkedFile   : String12 ;
  106.    Entry                  : String54 ;
  107.    Copyrite               : ARRAY [1..28] OF BYTE ;
  108.    Fld, TempFld           : ARRAY [1..NbrOfFields] OF FieldRec ;
  109.    Prompt                 : ARRAY [1..NbrOfFields] OF STRING[30] ;
  110.    ThisCard, TempCard     : Unit ;
  111.    Head, Last,
  112.    Insert, Current,
  113.    MarkedCard             : DataRecord ;
  114.    Config                 : TEXT ;
  115.    RD                     : FILE OF UNIT ;
  116.  
  117. (************************************************************************)
  118.  
  119. { INCLUDE FILES SECTION }
  120.  
  121. {$I TOOLS.INC}
  122. {$I COFFSCN.INC}
  123. {$I CSIZESCN.INC}
  124.  
  125. (************************************************************************)
  126.  
  127. PROCEDURE ClearBox ;
  128.  
  129. BEGIN
  130. IF Monitor = 'M' THEN
  131.    FOR Counter := 9 TO 17 DO
  132.        BEGIN
  133.        Window (1,1,80,25) ;
  134.        GotoXY(13,Counter) ;
  135.        Writeln (Blank+' ') ;
  136.        END
  137.    ELSE
  138.    BEGIN
  139.    Window (13,9,68,17) ;
  140.    GotoXY(13,Counter) ;
  141.    TextBackground (Blue) ;
  142.    ClrScr ;
  143.    WINDOW (1,1,80,25) ;
  144.    END ;
  145. END ;
  146.  
  147. (************************************************************************)
  148.  
  149. FUNCTION GetKey (VAR FunctionKey : Boolean) : CHAR ;
  150.  
  151. BEGIN
  152. Read (KBD,CharIn) ;
  153. IF (CharIn = #27) AND KeyPressed THEN (* it must be a function key *)
  154.    BEGIN
  155.    Read (KBD,CharIn) ;
  156.    FunctionKey := TRUE ;
  157.    END ELSE
  158.        FunctionKey := FALSE ;
  159.    GetKey := CharIn ;
  160.    CharIn := Upcase(CharIn) ;
  161. END ;
  162.  
  163. (************************************************************************)
  164.  
  165. PROCEDURE UpString (VAR Word : String12) ;
  166.  
  167. BEGIN
  168. FOR Counter := 1 TO Length(Word) DO Word[Counter] := UpCase(Word[Counter]) ;
  169. END ;
  170.  
  171. (************************************************************************)
  172.  
  173. PROCEDURE FunctionKeyInfo ;
  174.  
  175. BEGIN
  176. NormVideo ; TextColor (White) ; TextBackground (Grn) ;
  177. GotoXY(72,5) ; Write (' M MARK  ') ;
  178. GotoXY(72,6) ; Write (' T TRANS ') ;
  179. GotoXY(72,7) ; Write ('F1 CONFIG') ;
  180. GotoXY(71,20) ;
  181. Window (71,19,80,24) ;
  182. TextColor (White) ; TextBackGround(Grn) ;
  183. Write (' F2 ADD   ') ;
  184. Write (' F4 GOTO  ') ;
  185. Write (' F6 EDIT  ') ;
  186. Write (' F8 KILL  ') ;
  187. Write (' F9 PRINT ') ;
  188. Write ('F10 SAVE ') ;
  189. Window (1,1,80,25) ;
  190. TextBackGround (Black) ;
  191. GotoXY(14,9) ;
  192. END ;
  193.  
  194. (************************************************************************)
  195.  
  196. PROCEDURE DataToScreen ;
  197.  
  198. BEGIN
  199. __COffScn (TRUE) ;
  200. Nbr := 1 ; NormVideo ;
  201. TextColor (White) ; TextBackground (Green) ;
  202. GotoXY(68,2) ; Write ('DataFile') ;
  203. GotoXY(68,3) ; ClrEOL ;
  204. GotoXY(68,3) ; Write (DataFile) ;
  205. TextColor (Blue) ; TextBackground (Blue) ;
  206. GotoXY(1,1) ; Write ('                            ') ;
  207. GotoXY(1,1) ;
  208. IF Current^.Card.Area <> DefaultArea THEN
  209. Write (Access,Current^.Card.Area,'-') ;
  210. Write (Current^.Card.Fone1,'-',Current^.Card.Fone2) ;
  211. TextColor (Dim) ; TextBackGround (Black) ;
  212. IF Monitor <> 'G' THEN LowVideo ;
  213. GotoXY(11,3) ; Writeln (Blank) ;
  214. GotoXY(11,3) ; Writeln (Current^.NextNode^.NextNode^.NextNode^.Card.Last) ;
  215. GotoXY(30,3) ; Writeln (Current^.NextNode^.NextNode^.NextNode^.Card.First) ;
  216. GotoXY(51,3) ; Writeln (Current^.NextNode^.NextNode^.NextNode^.Card.Area) ;
  217. GotoXY(56,3) ; Writeln (Current^.NextNode^.NextNode^.NextNode^.Card.Fone1) ;
  218. GotoXY(59,3) ; Writeln ('-',Current^.NextNode^.NextNode^.NextNode^.Card.Fone2) ;
  219. GotoXY(12,5) ; Writeln (Blank) ;
  220. GotoXY(12,5) ; Writeln (Current^.NextNode^.NextNode^.Card.Last) ;
  221. GotoXY(31,5) ; Writeln (Current^.NextNode^.NextNode^.Card.First) ;
  222. GotoXY(52,5) ; Writeln (Current^.NextNode^.NextNode^.Card.Area) ;
  223. GotoXY(57,5) ; Writeln (Current^.NextNode^.NextNode^.Card.Fone1) ;
  224. GotoXY(60,5) ; Writeln ('-',Current^.NextNode^.NextNode^.Card.Fone2) ;
  225. GotoXY(13,7) ; Writeln (Blank) ;
  226. GotoXY(13,7) ; Writeln (Current^.NextNode^.Card.Last) ;
  227. GotoXY(32,7) ; Writeln (Current^.NextNode^.Card.First) ;
  228. GotoXY(53,7) ; Writeln (Current^.NextNode^.Card.Area) ;
  229. GotoXY(58,7) ; Writeln (Current^.NextNode^.Card.Fone1) ;
  230. GotoXY(61,7) ; Writeln ('-',Current^.NextNode^.Card.Fone2) ;
  231. GotoXY(14,9) ;
  232.  
  233. NormVideo ;
  234. TextBackGround(Blu) ; TextColor(Yellow) ;
  235. ClearBox ;
  236. GotoXY(14,9) ; Writeln (Current^.Card.Last) ;
  237. GotoXY(33,9) ; Writeln (Current^.Card.First) ;
  238. GotoXY(54,9) ; Writeln (Current^.Card.Area) ;
  239. GotoXY(59,9) ; Writeln (Current^.Card.Fone1) ;
  240. GotoXY(62,9) ; Writeln ('-',Current^.Card.Fone2) ;
  241. GotoXY(14,10) ; Writeln (Current^.Card.Addr) ;
  242. GotoXY(14,11) ; Writeln (Current^.Card.City) ;
  243. GotoXY(41,11) ; Writeln (Current^.Card.State) ;
  244. GotoXY(44,11) ; Writeln (Current^.Card.Zip) ;
  245. GotoXY(50,11) ; Writeln (Current^.Card.ExtZip) ;
  246. IF Current  = MarkedCard THEN
  247.    BEGIN GotoXY(60,12) ; Write ('(Marked)') ; END ;
  248. FOR Counter := 1 To 5 DO
  249.     BEGIN GotoXY(14,Counter+12) ; Writeln (Current^.Card.L[Counter]) ; END ;
  250.  
  251. TextColor (Dim) ; TextBackGround (Black) ;
  252. IF Monitor <> 'G' THEN LowVideo ;
  253. GotoXY(13,19) ; Writeln (Blank) ;
  254. GotoXY(13,19) ; Writeln (Current^.PrevNode^.Card.Last) ;
  255. GotoXY(32,19) ; Writeln (Current^.PrevNode^.Card.First) ;
  256. GotoXY(53,19) ; Writeln (Current^.PrevNode^.Card.Area) ;
  257. GotoXY(58,19) ; Writeln (Current^.PrevNode^.Card.Fone1) ;
  258. GotoXY(61,19) ; Writeln ('-',Current^.PrevNode^.Card.Fone2) ;
  259. GotoXY(12,21) ; Writeln (Blank) ;
  260. GotoXY(12,21) ; Writeln (Current^.PrevNode^.PrevNode^.Card.Last) ;
  261. GotoXY(31,21) ; Writeln (Current^.PrevNode^.PrevNode^.Card.First) ;
  262. GotoXY(52,21) ; Writeln (Current^.PrevNode^.PrevNode^.Card.Area) ;
  263. GotoXY(57,21) ; Writeln (Current^.PrevNode^.PrevNode^.Card.Fone1) ;
  264. GotoXY(60,21) ; Writeln ('-',Current^.PrevNode^.PrevNode^.Card.Fone2) ;
  265. GotoXY(11,23) ; Writeln (Blank) ;
  266. GotoXY(11,23) ; Writeln (Current^.PrevNode^.PrevNode^.PrevNode^.Card.Last) ;
  267. GotoXY(30,23) ; Writeln (Current^.PrevNode^.PrevNode^.PrevNode^.Card.First) ;
  268. GotoXY(51,23) ; Writeln (Current^.PrevNode^.PrevNode^.PrevNode^.Card.Area) ;
  269. GotoXY(56,23) ; Writeln (Current^.PrevNode^.PrevNode^.PrevNode^.Card.Fone1) ;
  270. GotoXY(59,23) ; Writeln ('-',Current^.PrevNode^.PrevNode^.PrevNode^.Card.Fone2) ;
  271. NormVideo ; TextBackground (Black) ;
  272. END ;
  273.  
  274. (************************************************************************)
  275.  
  276. PROCEDURE Locate ;
  277.  
  278. VAR
  279.    ContinueSearch : BOOLEAN ;
  280.    CurConcat, InsConcat : STRING[35] ;
  281.  
  282. BEGIN
  283. ContinueSearch := TRUE ;
  284. Current := Head ;
  285. InsConcat := Insert^.Card.Last+'/'+Insert^.Card.First ;
  286. IF Current = Current^.NextNode THEN  (* only one entry in list *)
  287.    BEGIN
  288.    Current^.PrevNode := Insert ;
  289.    Current^.NextNode := Insert ;
  290.    Insert^.PrevNode := Current ;
  291.    Insert^.NextNode := Current ;
  292.    IF InsConcat < Current^.Card.Last+'/'+Current^.Card.First
  293.       THEN Head := Insert
  294.       ELSE Last := Insert ;
  295.    END ELSE                          (* more than one entry in list *)
  296.        BEGIN
  297.        IF InsConcat < Head^.Card.Last+'/'+Head^.Card.First THEN
  298.           BEGIN
  299.           ContinueSearch := FALSE ;
  300.           Head^.PrevNode := Insert ;
  301.           Last^.NextNode := Insert ;
  302.           Insert^.PrevNode := Last ;
  303.           Insert^.NextNode := Head ;
  304.           Head := Insert ;
  305.           END
  306.        ELSE BEGIN
  307.             WHILE ContinueSearch = TRUE DO
  308.             BEGIN
  309.             Current := Current^.NextNode ;          (* advances pointer *)
  310.               IF Current^.Card.Last+'/'+Current^.Card.First >= InsConcat
  311.                  THEN ContinueSearch := FALSE ;
  312.               IF (InsConcat >= Current^.PrevNode^.Card.Last+'/'+
  313.                   Current^.PrevNode^.Card.First) AND
  314.                  (Current = Head) THEN ContinueSearch := FALSE ;
  315.               END ;
  316.        Insert^.PrevNode := Current^.PrevNode ;
  317.        Insert^.NextNode := Current ;
  318.        Current^.PrevNode^.NextNode := Insert ;
  319.        Current^.PrevNode := Insert ;
  320.        Current := Insert ;
  321.        END ;
  322.    END ;
  323. Current := Insert ;
  324. IF Current^.NextNode = Head THEN Last := Current ;
  325. END ;
  326.  
  327. (************************************************************************)
  328.  
  329. PROCEDURE Next ;
  330.  
  331. BEGIN
  332. Current := Current^.NextNode ;
  333. DataToScreen ;
  334. END ;
  335.  
  336. (************************************************************************)
  337.  
  338. PROCEDURE Prev ;
  339.  
  340. BEGIN
  341. Current := Current^.PrevNode ;
  342. DataToScreen ;
  343. END ;
  344.  
  345. (************************************************************************)
  346.  
  347. PROCEDURE Adv4 ;
  348.  
  349. BEGIN
  350. Current := Current^.NextNode^.NextNode^.NextNode^.NextNode ;
  351. DataToScreen ;
  352. END ;
  353.  
  354. (************************************************************************)
  355.  
  356. PROCEDURE Back4 ;
  357.  
  358. BEGIN
  359. Current := Current^.PrevNode^.PrevNode^.PrevNode^.PrevNode ;
  360. DataToScreen ;
  361. END ;
  362.  
  363. (************************************************************************)
  364.  
  365. PROCEDURE HomeCard ;
  366.  
  367. BEGIN
  368. Current := Head ;
  369. DataToScreen ;
  370. END ;
  371.  
  372. (************************************************************************)
  373.  
  374. PROCEDURE Delete ;
  375.  
  376. VAR
  377.    Entry : CHAR ;
  378.    Goner : DataRecord ;
  379.  
  380. BEGIN
  381. TextColor (White+Blink) ;
  382. GotoXY(71,22) ; Write ('    KILL  ') ;
  383. GotoXY(14,12) ; TextBackground (Red) ;
  384. TextColor (White) ;         Write (' VERIFY YOU WISH TO ') ;
  385. TextColor (White + Blink) ; Write ('DELETE') ;
  386. TextColor (White) ;         Write (' THIS CARD (Y/N)            ') ;
  387. GotoXY (57,12) ;
  388. __COffScn (FALSE) ;
  389. __CSizeScn (Top,Bottom) ;
  390. REPEAT DELAY(200) UNTIL KeyPressed ;
  391. Read (KBD,Entry) ;
  392. __COffScn (TRUE) ;
  393. Entry := UpCase(Entry) ;
  394. CASE Entry OF
  395.      'Y' : BEGIN
  396.            Goner := Current ;
  397.            IF Current = Head THEN Head := Current^.NextNode ;
  398.            IF Current = Last Then Last := Current^.PrevNode ;
  399.            Current^.PrevNode^.NextNode := Current^.NextNode ;
  400.            Current^.NextNode^.PrevNode := Current^.PrevNode ;
  401.            Current := Current^.NextNode ;
  402.            DataToScreen ;
  403.            Changed := TRUE ;
  404.            IF Goner^.PrevNode <> Goner THEN DISPOSE (Goner) ;
  405.            END ;
  406.      END ;
  407. TextBackGround(Blu) ;
  408. GotoXY(14,12) ; Write (Blank54) ;
  409. FunctionKeyInfo ;
  410. TextBackGround (Black) ;
  411. GotoXY(14,9) ;
  412. END ;
  413.  
  414. (************************************************************************)
  415.  
  416. PROCEDURE GotoCard ;
  417.  
  418. LABEL 1, 2 ;
  419.  
  420. VAR
  421.    Entry           : STRING[35] ;
  422.    ContinueSearch,
  423.    Stop            : BOOLEAN ;
  424.    FirstName       : STRING[15] ;
  425.    LastName        : STRING[19] ;
  426.    FirstPos        : 0..35 ;
  427.    Pos             : 1..15 ;
  428.  
  429. BEGIN
  430. TextColor (White + Blink) ;
  431. GotoXY(71,20) ; Write ('    GOTO  ') ;
  432. TextColor (Yellow) ;
  433. ContinueSearch := TRUE ;
  434. FirstName := '               ' ;
  435. LastName  := '                   ' ;
  436. FirstPos  := 0 ; Pos := 1 ;
  437. IF EntryGotoCard THEN
  438.    BEGIN
  439.    Entry := ParamStr(2) ;
  440.    EntryGotoCard := FALSE ;
  441.    GotoXY(14,9) ; Window (14,9,68,12) ;
  442.    END ELSE
  443.    BEGIN
  444.    ClearBox ;
  445.    GotoXY(23,10) ; Write ('     Enter name(s) to match') ;
  446.    GotoXY(23,11) ; Write ('Last name or Last name/First name') ;
  447.    GotoXY(23,12) ; Write ('    IE: CARSON or CARSON/MARK') ;
  448.    GotoXY(14,9) ; Window (14,9,68,12) ;
  449.    __COffScn (FALSE) ;
  450.    __CSizeScn (Top,Bottom) ;
  451.    Readln (Entry) ;
  452.    __COffScn (TRUE) ;
  453.    END ;
  454. FOR Counter := 1 TO Length(Entry) DO Entry[Counter] := Upcase(Entry[Counter]) ;
  455. IF Entry <> '' THEN
  456.    BEGIN
  457.    Current := Head ;
  458.    Counter := 1 ;
  459.    Stop := FALSE ;
  460.    WHILE Stop = FALSE DO
  461.          BEGIN
  462.          IF Entry[Counter] = '/' THEN
  463.             BEGIN
  464.             FirstPos := Counter + 1 ;
  465.             Stop := TRUE ;
  466.          END ;
  467.          IF Counter = Length(Entry) THEN Stop := TRUE
  468.          ELSE Counter := Counter + 1 ;
  469.          END ;
  470.    IF FirstPos <> 0 THEN
  471.       BEGIN
  472.       FOR Counter := 1 TO FirstPos-2 DO
  473.           LastName[Counter] := Entry[Counter] ;
  474.       FOR Counter := FirstPos TO Length(Entry) DO
  475.           BEGIN
  476.           FirstName[Pos] := Entry[Counter] ;
  477.           Pos := Pos + 1 ;
  478.           END ;
  479.       END ELSE LastName := Entry ;
  480.    Window (1,1,80,25) ;
  481.    IF LastName <= Current^.Card.Last THEN ContinueSearch := FALSE ;
  482.    While ContinueSearch = TRUE DO
  483.       BEGIN
  484.       Current := Current^.NextNode ;
  485.       IF LastName <= Current^.Card.Last THEN ContinueSearch := FALSE ;
  486.       IF (LastName >= Current^.PrevNode^.Card.Last)
  487.          AND (Current = Head) THEN ContinueSearch := FALSE ;
  488.       END ;
  489.    IF FirstPos <> 0 THEN
  490.       WHILE (LastName = Current^.Card.Last) AND
  491.          (FirstName > Current^.Card.First) DO Current := Current^.NextNode ;
  492.    END ELSE ClearBox ;
  493. DataToScreen ;
  494. FunctionKeyInfo ;
  495. END ;
  496.  
  497. (************************************************************************)
  498.  
  499.  
  500. PROCEDURE FileNameError ;
  501.  
  502. VAR
  503.    OK : BOOLEAN ;
  504.  
  505. BEGIN
  506. GotoXY(1,25) ;
  507. TextColor (White+Blink) ; TextBackground (Red) ; ClrEOL ;
  508. GotoXY(1,25) ; Write (DataFile) ;
  509. TextColor (White) ; Write (' is NOT a legal file name - Enter new file name : ') ;
  510. Read (DataFile) ;
  511. ASSIGN (RD,DataFile) ;
  512. {$I-} REWRITE (RD) ; {$I+}
  513. OK := (IOResult = 0) ;
  514. IF NOT OK THEN FileNameError ;
  515. TextBackground (Blu) ; GotoXY(1,25) ; ClrEOL ;
  516. GotoXY(1,25) ; TextColor (Yellow) ; Write (InfoLine) ;
  517. END ;
  518.  
  519. (************************************************************************)
  520.  
  521. PROCEDURE SaveToDisk ;
  522.  
  523. LABEL 1 ;
  524.  
  525. VAR
  526.    OK : BOOLEAN ;
  527.  
  528. BEGIN
  529. TextColor (White + Blink) ; TextBackground (Black) ;
  530. GotoXY(71,24) ; Write ('    SAVE  ') ;
  531. {$I-} RESET (RD) ; {$I+}
  532. OK := (IOResult = 0) ;
  533. IF NOT OK THEN
  534.    BEGIN
  535.    TextBackground (Red) ; GotoXY(1,25) ; ClrEOL ;
  536.    GotoXY(1,25) ; Write (DataFile:12,' NOT ON LOGGED DRIVE   ') ;
  537.    TextColor (White) ;
  538.    Write (#17,#196,#217,' TO SAVE ON CURRENT DRIVE OR Esc TO ABORT') ;
  539.    Read (KBD,CharIn) ;
  540.    IF CharIn = #27 THEN
  541.       BEGIN
  542.       GotoXY(1,25) ; ClrEol ;
  543.       GotoXY(1,25) ; Write ('Aborted - File NOT Saved ') ;
  544.       Delay (3000) ; TextBackground (Blu) ; GotoXY(1,25) ; ClrEol ;
  545.       TextColor (Yellow) ; Write (InfoLine) ;
  546.       GOTO 1 ;
  547.       END ;
  548.    TextBackGround (Blu) ; TextColor (Yellow) ;
  549.    GotoXY(1,25) ; ClrEOL ;
  550.    GotoXY(1,25) ; Write (InfoLine) ;
  551.    END  ;
  552. {$I-} CLOSE (RD) ; {$I+}
  553. ASSIGN (RD,DataFile) ;
  554. {$I-} REWRITE (RD) ; {$I+}
  555. OK := (IOResult = 0) ;
  556. IF NOT OK THEN FileNameError ;
  557. Current := Head ;
  558. WHILE Current <> Last DO
  559.       BEGIN
  560.       Write (RD,Current^.Card) ;
  561.       Current := Current^.NextNode ;
  562.       END ;
  563. Write (RD,Current^.Card) ;
  564. CLOSE (RD) ;
  565. Changed := FALSE ;
  566. 1 : FunctionKeyInfo ;
  567. END ;
  568.  
  569. (************************************************************************)
  570.  
  571. PROCEDURE PrinterMode ;
  572.  
  573. BEGIN
  574. NormVideo ; TextColor (White+Blink) ; TextBackground (Black) ;
  575. GotoXY(72,7) ; ClrEOL ; GotoXY(72,7) ; Write (' PRINTER') ;
  576. TextColor (White) ; GotoXY(80,25) ;
  577. END ;
  578.  
  579. (************************************************************************)
  580.  
  581. PROCEDURE PrintCard ;
  582.  
  583. BEGIN
  584. PrinterMode ;
  585. WITH Current^.Card DO
  586.      BEGIN
  587.      Writeln (LST,Last,' ',First,'     ',Area,' ',Fone1:3,'-',Fone2:4) ;
  588.      Writeln (LST,Addr) ;
  589.      Writeln (LST,City,'   ',State,'  ',ZIP,' ',ExtZip) ;
  590.      Writeln (LST) ;
  591.      FOR Counter := 1 TO 5 DO Writeln (LST,L[Counter]) ;
  592.      Writeln (LST) ; Writeln (LST) ; Writeln (LST) ;
  593.      END ;
  594. END ;
  595.  
  596. (************************************************************************)
  597.  
  598. PROCEDURE PrintLabel ;
  599.  
  600. VAR
  601.    Temp : STRING[15] ;
  602.    Pos  : INTEGER  ;
  603.  
  604. BEGIN
  605. PrinterMode ;
  606. WITH Current^.Card DO
  607.      BEGIN
  608.      Pos := 15 ;
  609.      Temp := '' ;
  610.      WHILE First[Pos] < #48 DO Pos := Pos - 1 ;
  611.      Temp := Copy (First,1,Pos) ;
  612.      Writeln (LST,Temp,' ',Last) ;
  613.      Writeln (LST,Addr) ;
  614.      Pos := 26 ;
  615.      Temp := '' ;
  616.      WHILE City[Pos] < #48 DO Pos := Pos - 1 ;
  617.      Temp := Copy (City,1,Pos) ;
  618.      Writeln (LST,Temp,'  ',State,'  ',ZIP,' ',ExtZip) ;
  619.      Writeln (LST) ; Writeln (LST) ; Writeln (LST) ;
  620.      END ;
  621. END ;
  622.  
  623. (************************************************************************)
  624.  
  625. PROCEDURE PrintAll (Format : CHAR) ;
  626.  
  627. VAR
  628.    Continue     : BOOLEAN ;
  629.    FormatName   : STRING [6] ;
  630.  
  631. BEGIN
  632. IF Format = 'L' THEN FormatName := 'LABEL ' ELSE FormatName := 'CARD  ' ;
  633. GotoXY(71,20) ; Window (71,19,80,24) ;
  634. Write (' PRINTING ') ;
  635. Write (' ALL ITEMS') ;
  636. Write (' IN ',FormatName) ;
  637. Write (' FORMAT   ') ;
  638. TextColor (White + Blink) ;
  639. Write ('  Esc TO  ') ;
  640. Write ('  ABORT  ') ;
  641. Window (1,1,80,25) ;
  642. TextColor (White) ;
  643. GotoXY(14,9) ;
  644. Current := Head ;
  645. Continue := TRUE ;
  646. WHILE Continue = TRUE DO
  647.       BEGIN
  648.       IF Format = 'L' THEN PrintLabel ELSE PrintCard ;
  649.       IF KeyPressed THEN
  650.          BEGIN
  651.          Read (KBD,CharIn) ;
  652.          IF CharIn = #27 THEN Continue := False ;
  653.          END ;
  654.       IF Current = Last THEN Continue := FALSE ;
  655.       Current := Current^.NextNode ;
  656.       END ;
  657. Current := Head ;
  658. DataToScreen ;
  659. FunctionKeyInfo ;
  660. END ;
  661.  
  662. (************************************************************************)
  663.  
  664. PROCEDURE GetFunctionKey ;
  665.  
  666. BEGIN
  667. Key := Cursor ;
  668. CASE Ch2 OF
  669.      #71 : CursorDir := Home   ;
  670.      #72 : CursorDir := Up     ;
  671.      #75 : CursorDir := Left   ;
  672.      #77 : CursorDir := Right  ;
  673.      #79 : CursorDir := EndKey ;
  674.      #80 : CursorDir := Down   ;
  675.      END ;
  676. END ;
  677.  
  678. (************************************************************************)
  679.  
  680. PROCEDURE KeyCheck ;
  681.  
  682. BEGIN
  683. Ch2 := #32 ;
  684. IF ((Ch = #27) AND KeyPressed) THEN
  685.    BEGIN
  686.    Read (KBD,Ch2) ;
  687.    IF Ch2 IN [#71..#81] THEN GetFunctionKey ;
  688.    IF Ch2 = #59 THEN Key := F1 ;
  689.    END
  690.    ELSE Case Ch OF
  691.         #8         : Key := Backspace;
  692.         #13        : Key := Return   ;
  693.         #27        : Key := Escape   ;
  694.         ELSE         Key := Regular  ;
  695.         END ;
  696. END ;
  697.  
  698. (************************************************************************)
  699.  
  700. PROCEDURE Add ;
  701.  
  702. VAR
  703.    Mem : INTEGER ;
  704.    OK : BOOLEAN ;
  705.  
  706. BEGIN
  707. GotoXY(71,19) ; Write ('    ADD   ') ;
  708. ClearBox ;
  709. NEW (Insert) ;
  710. WITH Insert^.Card DO
  711.      BEGIN
  712.      Last   := Blank19 ; First  := Blank15 ; Area := Blank3      ;
  713.      Fone1  := Blank3  ; Fone2  := Blank4  ; Addr := Blank54     ;
  714.      City   := Blank26 ; State  := Blank2  ; Zip  := Blank5      ;
  715.      ExtZIP := Blank4  ;
  716.      FOR Counter := 1 TO 5 DO L[Counter] := Blank54 ;
  717.      END ;
  718. Mem := MemAvail ; Mem := Mem DIV 27 ;
  719. IF (Mem < 10) AND (Mem >= 0) THEN
  720.    BEGIN
  721.    TextColor (White+Blink) ; TextBackground (Red) ;
  722.    GotoXY(13,13) ; Write ('     WARNING  ') ;
  723.    TextColor (White) ; Write ('-  Only ',Mem,' blank cards left in memory.     ') ;
  724.    TextColor (Yellow) ; TextBackground (Blue) ;
  725.    END ;
  726. END ;
  727.  
  728. (************************************************************************)
  729.  
  730. PROCEDURE EDIT (EditStatus : CHAR);
  731.  
  732.  
  733.  
  734. TYPE
  735.     Code       = (Continue, NextField, PrevField,
  736.                   FirstField, EndChange, EndSame) ;
  737.  
  738. VAR
  739.  
  740.    FldNbr          : 1..NbrOfFields    ;
  741.    ExitCode        : Code              ;
  742.    Run, Reorder    : BOOLEAN ;
  743.  
  744. (************************************************************************)
  745.  
  746. PROCEDURE Ed  ;
  747.  
  748. BEGIN
  749.   GotoXY(1,4) ; ClrEOL ; GotoXY(1,4) ; Write (Prompt[FldNbr]) ;
  750.   TextColor (Black) ; TextBackground (White) ;
  751.   GotoXY (Fld[FldNbr].X,Fld[FldNbr].Y) ;
  752.   FOR Counter := 1 TO (Fld[FldNbr].Len) DO Write (#32) ;
  753.   GotoXY (Fld[FldNbr].X,Fld[FldNbr].Y) ; Write (Fld[FldNbr].Str) ;
  754.   GotoXY (Fld[FldNbr].X,Fld[FldNbr].Y) ;
  755.   Pos := 1 ;
  756.   While ExitCode = Continue DO
  757.       BEGIN
  758.       Read (KBD,Ch) ;
  759.       KeyCheck ;
  760.       CASE Key OF
  761.            Regular : BEGIN
  762.                      Write (Ch) ;
  763.                      Fld[FldNbr].Str[Pos] := Ch ;
  764.                      IF Pos < Fld[FldNbr].Len
  765.                         THEN Pos := Pos + 1
  766.                         ELSE GotoXY (Fld[FldNbr].X+Pos-1,Fld[FldNbr].Y) ;
  767.                      END ;
  768.             Return : IF FldNbr <> NbrOfFields
  769.                         THEN ExitCode := NextField
  770.                         ELSE ExitCode := EndChange ;
  771.          Backspace : IF Pos > 1 THEN
  772.                      BEGIN
  773.                      Pos := Pos - 1 ;
  774.                      GotoXY(Fld[FldNbr].X+Pos-1,Fld[FldNbr].Y) ;
  775.                      Fld[FldNbr].Str[Pos] := #32 ;
  776.                      Write (Fld[FldNbr].Str[Pos]) ;
  777.                      GotoXY(Fld[FldNbr].X+Pos-1,Fld[FldNbr].Y) ;
  778.                      END ELSE
  779.                          BEGIN
  780.                          Write (#7) ;
  781.                          END ;
  782.            Cursor  : CASE CursorDir OF
  783.                           Left : BEGIN
  784.                                  IF Pos > 1
  785.                                     THEN Pos := Pos - 1
  786.                                     ELSE Write (#7) ;
  787.                                  GotoXY(Fld[FldNbr].X+Pos-1,Fld[FldNbr].Y) ;
  788.                                  END ;
  789.                          Right : BEGIN
  790.                                  IF Pos < Fld[FldNbr].Len
  791.                                     THEN Pos := Pos + 1
  792.                                     ELSE Write (#7) ;
  793.                                  GotoXY(Fld[FldNbr].X+Pos-1,Fld[FldNbr].Y) ;
  794.                                  END ;
  795.                             Up : ExitCode := PrevField ;
  796.                           Down : ExitCode := NextField ;
  797.                           Home : ;
  798.                         EndKey : ExitCode := EndChange ;
  799.                        END ;            { end case cursordir }
  800.            Escape : ExitCode := EndSame ;
  801.            END ;     { end case key       }
  802.      END ;           { end while exitcode }
  803. TextColor (Yellow) ; TextBackground (Blue) ;
  804. GotoXY (Fld[FldNbr].X,Fld[FldNbr].Y) ; Write (Fld[FldNbr].Str) ;
  805. END ;                { end procedure edit }
  806.  
  807. (************************************************************************)
  808.  
  809. BEGIN
  810. __COffScn (FALSE) ;
  811. __CSizeScn (Top,Bottom) ;
  812. TextColor (White + Blink) ;
  813. TextBackGround (Black) ;
  814. IF EditStatus = 'E'
  815.    THEN BEGIN
  816.         GotoXY(71,21) ; Write ('    EDIT  ') ; ReOrder := FALSE ;
  817.         Insert := Current ;
  818.         END
  819.    ELSE Add ;
  820. TextColor (Yellow) ; TextBackground (Blue) ;
  821. GotoXY(1,25) ; ClrEol ; GotoXY(1,25) ;
  822. Write (' ',#27,#26,' PREV/NEXT LETTER   ',#18,' PREV/NEXT FIELD   End DONE   Esc ABORT  ',#17,#196,#217,' NEXT FIELD') ;
  823. TextBackground (Blu) ; GotoXY(14,9) ;
  824. Window (14,9,68,17) ;
  825. ExitCode := Continue ;
  826. Run := TRUE ;
  827.  
  828. Fld[1].Str := Blank19 ;
  829. Fld[2].Str := Blank15 ;
  830. Fld[3].Str := Blank3  ;
  831. Fld[4].Str := Blank3  ;
  832. Fld[5].Str := Blank4  ;
  833. Fld[6].Str := Blank54 ;
  834. Fld[7].Str := Blank26 ;
  835. Fld[8].Str := Blank2  ;
  836. Fld[9].Str := Blank5  ;
  837. Fld[10].Str := Blank4 ;
  838. FOR Counter := 1 TO 5 DO
  839.     Fld[Counter+10].Str := Blank54 ;
  840.  
  841. IF EditStatus = 'E' THEN WITH Insert^.Card DO
  842.      BEGIN
  843.      FOR Pos := 1 TO Length(Last)   DO Fld[1].Str[Pos]  := Last[Pos] ;
  844.      FOR Pos := 1 TO Length(First)  DO Fld[2].Str[Pos]  := First[Pos] ;
  845.      FOR Pos := 1 TO Length(Area)   DO Fld[3].Str[Pos]  := Area[Pos] ;
  846.      FOR Pos := 1 TO Length(Fone1)  DO Fld[4].Str[Pos]  := Fone1[Pos] ;
  847.      FOR Pos := 1 TO Length(Fone2)  DO Fld[5].Str[Pos]  := Fone2[Pos] ;
  848.      FOR Pos := 1 TO Length(Addr)   DO Fld[6].Str[Pos]  := Addr[Pos] ;
  849.      FOR Pos := 1 TO Length(City)   DO Fld[7].Str[Pos]  := City[Pos] ;
  850.      FOR Pos := 1 TO Length(State)  DO Fld[8].Str[Pos]  := State[Pos] ;
  851.      FOR Pos := 1 TO Length(ZIP)    DO Fld[9].Str[Pos]  := ZIP[Pos] ;
  852.      FOR Pos := 1 TO Length(ExtZIP) DO Fld[10].Str[Pos] := ExtZIP[Pos] ;
  853.      FOR Counter := 1 TO 5 DO
  854.          FOR Pos := 1 TO Length(L[Counter]) DO
  855.              Fld[Counter+10].Str[Pos] := L[Counter][Pos] ;
  856.      END ELSE
  857.      BEGIN
  858.      Fld[3].Str := DefaultArea ;
  859.      GotoXY(Fld[3].X,Fld[3].Y) ;
  860.      Write (Fld[3].Str) ;
  861.      END ;
  862.  
  863. FldNbr := 1 ;
  864. Pos := 1 ;
  865.  
  866. WHILE Run DO
  867.       BEGIN
  868.       CASE ExitCode OF
  869.            Continue  : Ed ;
  870.            EndSame   : Run := FALSE ;
  871.            EndChange : BEGIN
  872.                        Run := FALSE ;
  873.                        WITH Insert^.Card DO
  874.                             BEGIN
  875.                             IF EditStatus = 'E' THEN
  876.                                IF Last <> Fld[1].Str THEN ReOrder := TRUE ;
  877.                             Last  := Fld[1].Str   ; First  := Fld[2].Str  ;
  878.                             Area  := Fld[3].Str   ; Fone1  := Fld[4].Str  ;
  879.                             Fone2 := Fld[5].Str   ; Addr   := Fld[6].Str  ;
  880.                             City  := Fld[7].Str   ; State  := Fld[8].Str  ;
  881.                             ZIP   := Fld[9].Str   ; ExtZIP := Fld[10].Str ;
  882.                             FOR FldNbr := 11 TO 15
  883.                                 DO L[FldNbr-10] := Fld[FldNbr].Str ;
  884.                             FOR Counter := 1 TO Length(Last) DO
  885.                                 BEGIN
  886.                                 Last[Counter]  := UpCase(Last[Counter]) ;
  887.                                 First[Counter] := UpCase(First[Counter]) ;
  888.                                 END ;
  889.                             END ;
  890.                        END ;
  891.            NextField : BEGIN
  892.                        IF FldNbr < NbrOfFields THEN FldNbr := FldNbr + 1 ;
  893.                        ExitCode := Continue ;
  894.                        Ed ;
  895.                        END ;
  896.            PrevField : BEGIN
  897.                        IF FldNbr > 1 THEN FldNbr := FldNbr - 1 ;
  898.                        ExitCode := Continue ;
  899.                        Ed ;
  900.                        END ;
  901.            END ;
  902.       END ;
  903. IF ReOrder = TRUE THEN
  904.    BEGIN
  905.    Current^.PrevNode^.NextNode := Current^.NextNode ;
  906.    Current^.NextNode^.PrevNode := Current^.PrevNode ;
  907.    IF Insert = Last THEN Last := Current^.PrevNode ;
  908.    IF Insert = Head THEN Head := Current^.NextNode ;
  909.    Locate ;
  910.    END ;
  911. IF (EditStatus = 'A') AND (Insert^.Card.Last > #33)
  912.     THEN Locate
  913.     ELSE IF EditStatus = 'A' THEN Dispose(Insert) ;
  914.  
  915. IF (ExitCode = EndChange) AND (Reorder = FALSE) THEN Current := Insert ;
  916. Window (1,1,80,25) ;
  917. TextColor (Yellow) ; TextBackground (Blue) ;
  918. GotoXY(1,25) ; Write (InfoLine) ;
  919. DataToScreen ;
  920. FunctionKeyInfo ;
  921. __COffScn (TRUE) ;
  922. IF ExitCode <> EndSame THEN Changed := TRUE ;
  923. END ;
  924.  
  925. (************************************************************************)
  926.  
  927. PROCEDURE Screen ;
  928.  
  929. CONST
  930.      Row = 2 ;
  931.      Column = 9 ;
  932.      Len = 56 ;
  933.      Tall = 9 ;
  934.  
  935. VAR
  936.    R, C, Counter, Pos, Offset  : INTEGER ;
  937.  
  938. BEGIN
  939. ClrScr ; NormVideo ; TextBackGround (Green) ; ClrScr ;
  940. TextBackGround(Blue) ; TextColor(Yellow) ; ClrEOL ;
  941. GotoXY(29,1) ; Writeln ('CARDEX by Carson Info Svcs ') ;
  942. TextBackGround(Black) ; TextColor(White) ;
  943. R := Row ; C := Column ;
  944.  
  945. (* next three cards *)
  946. LowVideo ;
  947. FOR Counter := 0 TO 2 DO
  948.     BEGIN
  949.     GotoXY(C+Counter,R+Counter*2) ;
  950.     Write (CHR(218)) ;
  951.     FOR Pos := 1 TO Len DO Write (CHR(196)) ;
  952.     Writeln (CHR(191)) ;
  953.     GotoXY(C+Counter+1,R+Counter*2+1) ;
  954.     FOR Pos := 1 TO Len DO Write (' ') ;
  955.     GotoXY(C+Counter+Pos+1,R+Counter*2+1) ;
  956.     Writeln (CHR(179)) ;
  957.     FOR Pos := 1 TO 5 DO
  958.         BEGIN GotoXY(C+Counter,R+Counter*2+Pos) ; Writeln (CHR(179)) ; END ;
  959.     END ;
  960.  
  961. (* current card *)
  962. NormVideo ;
  963. TextBackground(Blu) ;
  964. ClearBox ;
  965. GotoXY(C+3,R+6) ; Write (CHR(201)) ; FOR Pos := 1 TO Len DO Write (CHR(205)) ;
  966. Writeln (CHR(187)) ;
  967. FOR Counter := 1 TO Tall DO
  968.     BEGIN
  969.     GotoXY(C+3,R+Counter+6) ; Writeln (CHR(186)) ;
  970.     GotoXY(C+3+Len+1,R+Counter+6) ; Writeln (CHR(186)) ;
  971.     END ;
  972. GotoXY(C+3,R+6+Tall+1) ; Write (CHR(200)) ;
  973. FOR Pos := 1 TO Len DO Write (CHR(205)) ; Writeln (CHR(188)) ;
  974.  
  975. (* previous three cards *)
  976. LowVideo ;
  977. FOR Counter := 1 TO 3 DO
  978.     BEGIN
  979.     GotoXY(C+3-Counter,R+7+Tall+Counter*2) ;
  980.     Write (CHR(192)) ;
  981.     FOR Pos := 1 TO Len DO Write (CHR(196)) ;
  982.     Writeln (CHR(217)) ;
  983.     GotoXY(C+4-Counter,R+6+Tall+Counter*2) ;
  984.     FOR Pos := 1 TO Len DO Write (' ') ;
  985.     GotoXY(C+4-Counter+Pos,R+6+Tall+Counter*2) ;
  986.     Writeln (CHR(179)) ;
  987.     FOR Pos := 0 TO 4 DO
  988.         BEGIN GotoXY(C+3-Counter,R+6+Tall+Counter*2-Pos) ; Writeln (CHR(179)) ; END ;
  989.     END ;
  990.  
  991. (* knobs *)
  992. TextColor (White) ; TextBackGround (Black) ; LowVideo ;
  993. FOR Counter := 1 TO 2 DO
  994.     BEGIN
  995.     IF Counter = 1 THEN Offset := 2 ELSE Offset := Len + 19 ;
  996.     GotoXY(Offset,R+6) ;
  997.     Writeln (CHR(201),CHR(205),CHR(205),CHR(205),CHR(187)) ;
  998.     GotoXY(Offset,R+7) ;
  999.     Writeln (CHR(186),' ',CHR(24),' ',CHR(186)) ;
  1000.     FOR Pos := 1 TO 7 DO
  1001.         BEGIN
  1002.         GotoXY(Offset,R+7+Pos) ;
  1003.         Writeln (CHR(204),CHR(205),CHR(205),CHR(205),CHR(185)) ;
  1004.         END ;
  1005.     GotoXY(Offset,R+15) ;
  1006.     Writeln (CHR(186),' ',CHR(25),' ',CHR(186)) ;
  1007.     GotoXY(Offset,R+16) ;
  1008.     Writeln (CHR(200),CHR(205),CHR(205),CHR(205),CHR(188)) ;
  1009.     IF Counter = 1 THEN Offset := 2 ELSE Offset := Len + C ;
  1010.     GotoXY(Offset+5,R+9) ;
  1011.     FOR Pos := 1 TO 5 DO Write (CHR(205)) ;
  1012.     FOR Pos := 1 TO 4 DO
  1013.         BEGIN GotoXY(Offset+5,R+9+Pos) ; Write ('     ') ; END ;
  1014.     GotoXY(Offset+5,R+13) ;
  1015.     FOR Pos := 1 TO 5 DO Write (CHR(205)) ;
  1016.     END ;
  1017.  
  1018. (* cusor control information *)
  1019. GotoXY(1,25) ;
  1020. NormVideo ; TextBackGround(Blue) ; TextColor(Yellow) ;
  1021. ClrEOL ; GotoXY(1,25) ;
  1022. Write (InfoLine) ;
  1023. TextColor (White) ;
  1024. TextBackground (Black) ;
  1025. END ;
  1026.  
  1027. (************************************************************************)
  1028.  
  1029. PROCEDURE DiskToMemory ;
  1030.  
  1031. LABEL 1 ;
  1032.  
  1033. VAR
  1034.    Mem : INTEGER ;
  1035.  
  1036. BEGIN
  1037. TextBackGround (Red) ; TextColor (White+Blink) ;
  1038. GotoXY(1,25) ; ClrEOL ; GotoXY(1,25) ;
  1039. Mem := MemAvail ; Mem := Mem DIV 27 ;
  1040. IF (Mem < FileSize(RD)) AND (Mem >= 0) THEN
  1041.    BEGIN
  1042.    Write (' LOAD FAILED') ; TextColor (White) ;
  1043.    Write (' - Available memory is not large enough to load data file') ;
  1044.    DELAY (4000) ; LoadFailed := TRUE ; GOTO 1 ;
  1045.    END ;
  1046. TextColor (White+Blink) ;
  1047. Write (' WAIT ') ; TextColor (White) ;
  1048. Write ('- Reading data from disk ') ;
  1049. RESET (RD) ;
  1050. IF NOT EOF (RD) THEN Read (RD,ThisCard) ;
  1051.  
  1052. NEW (Insert) ;
  1053.  
  1054. Insert^.Card := ThisCard ;
  1055. Insert^.PrevNode := Insert ;
  1056. Insert^.NextNode := Insert ;
  1057. Head := Insert ;
  1058. Current := Insert ;
  1059. While NOT EOF (RD) DO
  1060.      BEGIN
  1061.      Read (RD,ThisCard) ;
  1062.      NEW (Insert) ;
  1063.      Insert^.Card := ThisCard ;
  1064.      Insert^.PrevNode := Current ;
  1065.      Insert^.NextNode := Head ;
  1066.      Head^.PrevNode := Insert ;
  1067.      Current^.NextNode := Insert ;
  1068.      Current := Insert ;
  1069.      Last := Insert ;
  1070.      END ;
  1071. CLOSE (RD) ;
  1072. 1 : END ;
  1073.  
  1074. (************************************************************************)
  1075.  
  1076. PROCEDURE SetMonitor ;
  1077.  
  1078. BEGIN
  1079. CASE Monitor OF
  1080.        'C' : BEGIN
  1081.              TextMode (C80) ;
  1082.              Top := 6 ; Bottom := 7 ;
  1083.              Blue := 1 ; Green := 2 ; Red := 4 ;
  1084.              Yellow := 14 ; Grn := 2 ; Dim := 15 ; Blu := 1
  1085.              END ;
  1086.        'G' : BEGIN
  1087.              TextMode (C80) ;
  1088.              Top := 6 ; Bottom := 7 ;
  1089.              Blue := 1 ; Green := 2 ; Red := 4 ;
  1090.              Yellow := 15 ; Grn := 2 ; Dim := 5 ; Blu := 0 ;
  1091.              END
  1092.         ELSE BEGIN
  1093.              TextMode (BW80) ;
  1094.              Top := 12 ; Bottom := 13 ;
  1095.              Blue := 0 ; Green := 0 ; Red := 0 ;
  1096.              Yellow := 15 ; Grn := 0 ; Dim := 15 ; Blu := 0 ;
  1097.              END ;
  1098.         END ;       (* END CASE Monitor *)
  1099. END ;
  1100.  
  1101. (************************************************************************)
  1102.  
  1103. PROCEDURE AuthorsCard ;
  1104.  
  1105. BEGIN
  1106.   ThisCard.Last := 'CARSON INFORMATION' ;
  1107.   ThisCard.First := 'SERVICES       ' ;
  1108.   ThisCard.Area := '808' ;
  1109.   ThisCard.Fone1 := '595' ;
  1110.   ThisCard.Fone2 := '7119' ;
  1111.   ThisCard.Addr := '821-A Puunani Place                                   ' ;
  1112.   ThisCard.City := 'Honolulu                  ' ;
  1113.   ThisCard.State := 'HI' ;
  1114.   ThisCard.Zip := '96817' ;
  1115.   ThisCard.ExtZip := '    ' ;
  1116.   ThisCard.L[1] := 'CARDEX by Carson Information Services is NOT a public' ;
  1117.   ThisCard.L[2] := 'domain program. If you did not purchase the copy you ' ;
  1118.   ThisCard.L[3] := 'are using, and find the program useful, you are      ' ;
  1119.   ThisCard.L[4] := 'encouraged to send what you feel the program''s      ' ;
  1120.   ThisCard.L[5] := 'value ($) to you is to : CARSON INFORMATION SERVICES.' ;
  1121.   TempCard := ThisCard ;
  1122. END ;
  1123.  
  1124. (************************************************************************)
  1125.  
  1126. PROCEDURE DataIn ;
  1127.  
  1128. VAR
  1129.    OK : BOOLEAN ;
  1130.  
  1131. BEGIN
  1132. ASSIGN (RD,DataFile) ;
  1133. {$I-} RESET (RD) ; {$I+}
  1134. OK := (IOResult = 0) ;
  1135. IF NOT OK THEN
  1136.    BEGIN
  1137.          NEW (Current) ;
  1138.          AuthorsCard ;
  1139.          Current^.Card := ThisCard ;
  1140.          Current^.PrevNode := Current ;
  1141.          Current^.NextNode := Current ;
  1142.          Head := Current ;
  1143.          Last := Current ;
  1144.          END ELSE
  1145.              DiskToMemory ;
  1146. END ;
  1147.  
  1148. (************************************************************************)
  1149.  
  1150. PROCEDURE Configure ;
  1151.  
  1152. LABEL 1, 2 ;
  1153.  
  1154. VAR
  1155.    Entry : CHAR ;
  1156.    Entry2 : String12 ;
  1157.    Entry3 : STRING[27] ;
  1158.    Cont, OK,
  1159.    FileChanged,
  1160.    AreaChanged,
  1161.    AccessChanged,
  1162.    ScreenChanged,
  1163.    PrinterChanged : BOOLEAN ;
  1164.    Mem, NbrOfCards : INTEGER ;
  1165.  
  1166. BEGIN
  1167. __COffScn (FALSE) ;
  1168. __CSizeScn (Top,Bottom) ;
  1169. Entry2 := '' ;
  1170. ScreenChanged := FALSE ; AreaChanged := FALSE ;
  1171. FileChanged := FALSE ; PrinterChanged := FALSE ;
  1172. TextColor (White) ; TextBackground (Red) ;
  1173. ClrScr ;
  1174. FOR Counter := 1 TO 80 DO Write (#205) ;
  1175. Writeln ('                        CARDEX by Carson Information Services') ;
  1176. Writeln ;
  1177. Writeln ('                                CONFIGURATION SET-UP') ;
  1178. Writeln ;
  1179. FOR Counter := 1 TO 80 DO Write (#205) ;
  1180. GotoXY(2,8) ; Write ('OPTIONS') ;
  1181. GotoXY(58,8) ; Write ('CURRENT DATA') ;
  1182. IF JustStarted THEN GOTO 2 ;
  1183. NbrOfCards := 1 ;
  1184. Current := Head ;
  1185. WHILE Cont DO
  1186.       BEGIN
  1187.       IF Current = Head^.PrevNode THEN Cont := FALSE
  1188.       ELSE BEGIN
  1189.            NbrOfCards := NbrOfCards + 1 ;
  1190.            Current := Current^.NextNode ;
  1191.            END ;
  1192.       END ;
  1193. GotoXY(2,24) ; Write ('Number of cards in the current file - ',NbrOfCards) ;
  1194.  
  1195. Mem := MemAvail ; Mem := Mem DIV 27 ;
  1196. GotoXY(2,25) ; Write ('Available blank cards in memory     - ',Mem) ;
  1197.  
  1198. 2 : Gotoxy(2,10) ; Write ('Monitor : Color, Graphics, Monochrome (C/G/M) - ') ;
  1199. GotoXY(58,10) ;
  1200. CASE Monitor OF
  1201.      'C' : Write ('Color') ;
  1202.      'G' : Write ('Graphics') ;
  1203.      'M' : Write ('Monochrome')
  1204.      ELSE Write ('Set up error') ;
  1205.      END ;         {end CASE Monitor}
  1206. GotoXY(50,10) ; Read (KBD,Entry) ; Entry := Upcase(Entry) ;
  1207. IF Entry = #27 THEN GOTO 1 ;
  1208. IF Entry <> #13 THEN
  1209.    BEGIN
  1210.    ScreenChanged := TRUE ;
  1211.    GotoXY(58,10) ; ClrEOL ;
  1212.    CASE Entry OF
  1213.         'C' : Monitor := 'C' ;
  1214.         'G' : Monitor := 'G'
  1215.          ELSE Monitor := 'M' ;
  1216.          END ;
  1217.    GotoXY(58,10) ;
  1218.    CASE Monitor OF
  1219.         'C' : Write ('Color') ;
  1220.         'G' : Write ('Graphics')
  1221.         ELSE Write ('Monochrome') ;
  1222.         END ;         {end CASE Monitor}
  1223.    END ;              {end IF Entry <> 13}
  1224.  
  1225. GotoXY(2,12)  ; Write ('Local telephone area code - ') ;
  1226. GotoXY(58,12) ; Write (DefaultArea) ;
  1227. GotoXY(32,12) ; Readln (Entry2) ;
  1228. IF Entry2 <> '' THEN
  1229.    BEGIN
  1230.    AreaChanged := TRUE ;
  1231.    DefaultArea := Entry2 ;
  1232.    GotoXY(32,12) ; ClrEOL ;
  1233.    GotoXY(58,12) ; Write (DefaultArea) ;
  1234.    END ;
  1235.  
  1236. GotoXY(2,14)  ; Write ('Long distance access code - ') ;
  1237. GotoXY(58,14) ; Write (Access) ;
  1238. GotoXY(32,14) ; Readln (Entry3) ;
  1239. IF Entry3 <> '' THEN
  1240.    BEGIN
  1241.    AccessChanged := TRUE ;
  1242.    Access := Entry3 ;
  1243.    GotoXY(32,14) ; ClrEOL ;
  1244.    GotoXY(58,14) ; Write (Access) ;
  1245.    END ;
  1246.  
  1247. Gotoxy(2,16) ; Write ('Send form feeds to printer : (Y/N) - ') ;
  1248. GotoXY(58,16) ;
  1249. CASE FormFeed OF
  1250.      'Y' : Write ('Form Feeds') ;
  1251.      'N' : Write ('No Form Feeds') ;
  1252.      ELSE Write ('Set up error') ;
  1253.      END ;         {end CASE FormFeed}
  1254. GotoXY(40,16) ; Read (KBD,Entry) ; Entry := Upcase(Entry) ;
  1255. IF Entry = #27 THEN GOTO 1 ;
  1256. GotoXY(58,16) ; ClrEOL ;
  1257. IF Entry <> #13 THEN
  1258.    BEGIN
  1259.    PrinterChanged := TRUE ;
  1260.    CASE Entry OF
  1261.         'Y' : FormFeed := 'Y' ;
  1262.          ELSE FormFeed := 'N' ;
  1263.          END ;
  1264.    END ;
  1265. GotoXY(58,16) ;
  1266. CASE FormFeed OF
  1267.         'Y' : Write ('Form Feeds') ;
  1268.         ELSE Write ('No Form Feeds') ;
  1269.         END ;         {end CASE FormFeeds}
  1270.  
  1271. Entry2 := '' ;
  1272. GotoXY(2,18)  ; Write ('Enter default data file name - ') ;
  1273. GotoXY(58,18) ; Write (DiskFile) ;
  1274. IF DataFile <> DiskFile THEN
  1275.    BEGIN
  1276.    GotoXY(50,20) ; Write ('( Data in use : ',DataFile,' )') ;
  1277.    END ;
  1278. GotoXY(34,18) ; Readln (Entry2) ;
  1279. __COffScn (TRUE) ;
  1280. UpString (Entry2) ;
  1281. IF Entry2 <> '' THEN
  1282.    BEGIN
  1283.    FileChanged := TRUE ;
  1284.    DataFile := Entry2 ;
  1285.    DiskFile := Entry2 ;
  1286.    GotoXY(34,18) ; ClrEOL ;
  1287.    GotoXY(58,18) ; Write (DataFile) ;
  1288.    END ;
  1289. IF InitialConfig THEN FileChanged := TRUE ;
  1290. IF FileChanged OR AreaChanged OR AccessChanged OR
  1291.    ScreenChanged OR PrinterChanged THEN
  1292.    BEGIN
  1293.    {$I-} RESET (Config) ; {$I+}
  1294.    OK := (IOResult = 0) ;
  1295.    IF NOT OK THEN
  1296.    BEGIN
  1297.         TextBackGround (Blue) ; TextColor (White+Blink) ;
  1298.         GotoXY(1,25) ; ClrEOL ;
  1299.         GotoXY(1,25) ; Write ('  CARDEX.CFG IS NOT ON LOGGED DRIVE ') ;
  1300.         TextColor (White) ;
  1301.         Write ('- PRESS ANY KEY TO SAVE ONTO CURRENT DRIVE') ;
  1302.         Read (KBD,CharIn) ;
  1303.    END  ;
  1304.    {$I-} CLOSE (Config) ; {$I+}
  1305.    REWRITE (Config) ;
  1306.    Writeln (Config,Monitor) ;
  1307.    Writeln (Config,DefaultArea) ;
  1308.    Writeln (Config,Access) ;
  1309.    Writeln (Config,FormFeed) ;
  1310.    Writeln (Config,DiskFile) ;
  1311.    CLOSE (Config) ;
  1312.    IF ScreenChanged THEN SetMonitor ;
  1313.    IF FileChanged AND Changed THEN SaveToDisk ;
  1314.    IF FileChanged THEN DataIn ;
  1315.    END ;
  1316. 1 : __COffScn (TRUE) ;
  1317. END ;
  1318.  
  1319. (************************************************************************)
  1320.  
  1321. PROCEDURE NewFile ;
  1322.  
  1323. VAR
  1324.    OldDataFile,
  1325.    NewDataFile : STRING[12] ;
  1326.    CR          : BOOLEAN ;
  1327.  
  1328. BEGIN
  1329. TempCard := MarkedCard^.Card ;
  1330. OldDataFile := DataFile ;
  1331. NewDataFile := '' ;
  1332. IF Changed = TRUE THEN SaveToDisk ;
  1333. TextColor (White) ; TextBackground (Red) ;
  1334. GotoXY(1,25) ; ClrEOL ;
  1335. GotoXY(71,25) ; Write (#17,#196,#217,' ABORT');
  1336. GotoXY(1,25) ; Write (' Enter name of new CARDEX data file - ') ;
  1337. __COffScn (FALSE) ;
  1338. __CSizeScn (Top,Bottom) ;
  1339. Read (NewDataFile) ;
  1340. __COffScn (TRUE) ;
  1341. UpString (NewDataFile) ;
  1342. IF NewDataFile <> '' THEN
  1343.    BEGIN
  1344.    Current := Head ;
  1345.    WHILE Current <> Last DO
  1346.          BEGIN
  1347.          Current := Current^.NextNode ;
  1348.          Dispose (Current^.PrevNode) ;
  1349.          END ;
  1350.    Dispose (Current) ;
  1351.    DataFile := NewDataFile ;
  1352.    DataIn ;
  1353.    IF LoadFailed THEN
  1354.       BEGIN
  1355.       DataFile := OldDataFile ;
  1356.       DataIn ;
  1357.       END ;
  1358.    Current := Head ;
  1359.    END ;
  1360. IF NewDataFile <> '' THEN DataToScreen ;
  1361. TextColor (Yellow) ; TextBackground  (Blue) ;
  1362. GotoXY(1,25) ; ClrEOL ; GotoXY(1,25) ; Write (InfoLine) ;
  1363. END ;
  1364.  
  1365. (************************************************************************)
  1366.  
  1367. PROCEDURE PrintMenu ;
  1368.  
  1369. VAR
  1370.    Cont : BOOLEAN ;
  1371.    Ch   : CHAR ;
  1372.  
  1373. BEGIN
  1374. Cont := TRUE ;
  1375. PrinterMode ; TextBackground (Grn) ;
  1376. GotoXY(71,20) ; Window (71,19,80,24) ;
  1377. Write (' F3 LABEL ') ;
  1378. Write (' F5 ALL   ') ;
  1379. Write ('    LABELS') ;
  1380. Write (' F7 ALL   ') ;
  1381. Write ('    CARDS ') ;
  1382. Write (' F9 CARD ') ;
  1383. Window (1,1,80,25) ;
  1384. TextBackGround (Black) ;
  1385. GotoXY(14,9) ;
  1386. While Cont DO
  1387.       BEGIN
  1388.       InKey := GetKey (FunctionKey) ;
  1389.       IF FunctionKey THEN
  1390.          BEGIN
  1391.          Cont := FALSE ;
  1392.          CASE InKey OF
  1393.            '=' : BEGIN            (* F3  single label  *)
  1394.                  PrintLabel ;
  1395.                  IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1396.                  FunctionKeyInfo ;
  1397.                  END ;
  1398.            '?' : BEGIN
  1399.                  PrintAll ('L') ; (* F5  label format  *)
  1400.                  IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1401.                  END ;
  1402.            'A' : BEGIN
  1403.                  PrintAll ('C') ; (* F7  card format   *)
  1404.                  IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1405.                  END ;
  1406.            'C' : BEGIN            (* F9  single card   *)
  1407.                  PrintCard ;
  1408.                  IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1409.                  FunctionKeyInfo ;
  1410.                  END ;
  1411.            END ;
  1412.          END ;
  1413.       IF InKey = #27 THEN BEGIN Cont := FALSE ; Inkey := ' ' ; END ;
  1414.       END ;
  1415. FunctionKeyInfo ;
  1416. END ;
  1417.  
  1418. (************************************************************************)
  1419.  
  1420. PROCEDURE DoFunctionCommand (FunctionKey : CHAR) ;
  1421.  
  1422. BEGIN
  1423. CASE FunctionKey OF
  1424.  'H','M' : Next ;           (* up/right cusor    *)
  1425.  'P','K' : Prev ;           (* dn/left cusor     *)
  1426.      'I' : Adv4 ;           (* page up           *)
  1427.      'Q' : Back4 ;          (* page dn           *)
  1428.      'G' : HomeCard ;       (* home              *)
  1429.      'O' : NewFile ;        (* end               *)
  1430.      ';' : BEGIN            (* F1                *)
  1431.            Configure ;         (* reconfigure    *)
  1432.            Screen ;            (* default file   *)
  1433.            Current := Head ;   (* and implement  *)
  1434.            DataToScreen ;      (* new defaults   *)
  1435.            FunctionKeyInfo ;   (* on the fly     *)
  1436.            END ;
  1437.      '<' : Edit ('A') ;     (* F2  add new entry *)
  1438.      '=' : BEGIN            (* F3                *)
  1439.            PrintLabel ;
  1440.            IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1441.            FunctionKeyInfo ;
  1442.            END ;
  1443.      '>' : GotoCard ;       (* F4                *)
  1444.      '?' : BEGIN
  1445.            PrintAll ('L') ; (* F5  label format  *)
  1446.            IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1447.            END ;
  1448.      '@' : Edit ('E');      (* F6  edit entry    *)
  1449.      'A' : BEGIN
  1450.            PrintAll ('C') ; (* F7  card format   *)
  1451.            IF FormFeed = 'Y' THEN Writeln (LST,#12) ;
  1452.            END ;
  1453.      'B' : Delete ;         (* F8                *)
  1454.      'C' : PrintMenu ;      (* F9                *)
  1455.      'D' : SaveToDisk ;     (* F10                *)
  1456.      END ;
  1457. END ;
  1458.  
  1459. (************************************************************************)
  1460.  
  1461. PROCEDURE MarkCard ;
  1462.  
  1463. BEGIN
  1464. MarkedFile := DataFile ;
  1465. MarkedCard := Current ;
  1466. DataToScreen ;
  1467. END ;
  1468.  
  1469. (************************************************************************)
  1470.  
  1471. PROCEDURE TransferCard ;
  1472.  
  1473. BEGIN
  1474. NEW (Insert) ;
  1475. Insert^.Card := TempCard ;
  1476. Locate ;
  1477. MarkedCard := Current ;
  1478. MarkedFile := DataFile ;
  1479. Changed := TRUE ;
  1480. DataToScreen ;
  1481. END ;
  1482.  
  1483.  
  1484. (************************************************************************)
  1485.  
  1486. PROCEDURE ReadConfiguration ;
  1487.  
  1488. VAR
  1489.    OK : BOOLEAN ;
  1490.  
  1491. BEGIN
  1492. ASSIGN (Config,'CARDEX.CFG') ;
  1493. {$I-} RESET (Config) ; {$I+}
  1494. OK := (IOResult = 0) ;
  1495. IF OK = TRUE THEN
  1496.    BEGIN
  1497.    Readln (Config,Monitor) ;
  1498.    Readln (Config,DefaultArea) ;
  1499.    Readln (Config,Access) ;
  1500.    Readln (Config,FormFeed) ;
  1501.    Readln (Config,DiskFile) ;
  1502.    DataFile := DiskFile ;
  1503.    CLOSE (Config) ;
  1504.    END ;
  1505. SetMonitor ;
  1506. END ;
  1507.  
  1508. (************************************************************************)
  1509.  
  1510. PROCEDURE PrintDocumentation ;
  1511.  
  1512. VAR
  1513.    Ch      : CHAR    ;
  1514.    DocFile : TEXT    ;
  1515.    OK      : BOOLEAN ;
  1516.  
  1517. BEGIN
  1518. ASSIGN (DocFile,'CARDEX.DOC') ;
  1519. {$I-} RESET (DocFile) ; {$I+}
  1520. OK := (IOResult = 0) ;
  1521. IF OK = TRUE THEN
  1522.    BEGIN
  1523.    WHILE NOT EOF (DocFile) DO
  1524.       BEGIN
  1525.       READ (DocFile,Ch) ; WRITE (Ch) ;
  1526.       END ;
  1527.    CLOSE (DocFile) ;
  1528.    END ELSE
  1529.    BEGIN
  1530.    Writeln ('CARDEX.DOC FILE NOT AVAILABLE ON CURRENT DISK/DIRECTORY') ;
  1531.    DELAY (5000) ;
  1532.    END ;
  1533. END ;
  1534.  
  1535. (************************************************************************)
  1536.  
  1537. PROCEDURE OpeningScreen ;
  1538.  
  1539. CONST
  1540.      X = 37 ;
  1541.  
  1542. LABEL 1 ;
  1543.  
  1544. VAR
  1545.    Entry             : STRING[12] ;
  1546.    CharIn            : CHAR ;
  1547.    KeyOK, Continue   : BOOLEAN ;
  1548.    Pos, Code         : INTEGER ;
  1549.  
  1550. BEGIN
  1551. IF Length(ParamStr(1)) > 0 THEN
  1552.    BEGIN
  1553.    IF ParamStr(1) = ('?') THEN
  1554.       BEGIN PrintDocumentation ; Abort := TRUE ; GOTO 1 ; END ;
  1555.    IF ParamStr(1) <> ('*') THEN DataFile := ParamStr(1) ;
  1556.    DataIn ; GOTO 1 ;
  1557.    END ;
  1558. NormVideo ; TextBackGround(Blu) ; TextColor(White) ; ClrScr ;
  1559. FOR Counter := 1 TO 80 DO Write (#205) ;
  1560. Writeln ('                        CARDEX by Carson Information Services') ;
  1561. Writeln ;
  1562. Write   ('         ',Copyright) ;
  1563. Writeln ('                 Version ',Version,' P/N') ;
  1564. Writeln ;
  1565. Write   (' Program CARDEX.COM') ;
  1566. Write   ('      Configuration CARDEX.CFG') ;
  1567. Writeln ('     Documentation CARDEX.DOC') ;
  1568. Writeln ;
  1569. FOR Counter := 1 TO 80 DO Write (#205) ;
  1570. GotoXY(1,12) ; FOR Counter := 1 TO 80 DO Write (#205) ;
  1571. GotoXY(21,13) ;
  1572. Window (21,13,80,24) ;
  1573. Writeln (' M  : MARK A CARD FOR TRANSFER TO ANOTHER FILE') ;
  1574. Writeln (' T  : TRANSFER (COPY) MARKED CARD TO CURRENT FILE') ;
  1575. Writeln (' F1 : CONFIGURE CARDEX SYSTEM') ;
  1576. Writeln (' F2 : ADD A NEW CARD TO FILE') ;
  1577. Writeln (' F3 : PRINT SINGLE ADDRESS LABEL') ;
  1578. Writeln (' F4 : GOTO - SELECT CARD TO ADVANCE TO') ;
  1579. Writeln (' F5 : PRINT ADDRESS LABELS') ;
  1580. Writeln (' F6 : EDIT CURRENT CARD') ;
  1581. Writeln (' F7 : PRINT CONTENTS OF CARDEX FILE') ;
  1582. Writeln (' F8 : DELETE CURRENT CARDEX CARD') ;
  1583. Writeln (' F9 : PRINT SUBMENU / PRINT CURRENT CARD') ;
  1584. Write   ('F10 : MANUALLY SAVE FILE TO DISK') ;
  1585. Window (1,1,80,25) ;
  1586. GotoXY(1,25) ; FOR Counter := 1 TO 79 DO Write (#205) ;
  1587. GotoXY(1,10) ; Write (' ENTER CARDEX DATA FILE TO BE USED - ') ;
  1588. Writeln ('             (Default file is ',DataFile,')') ;
  1589. GotoXY(38,10) ;
  1590. Ch := #32 ; Ch2 := #32 ; Pos := 1 ;
  1591. Continue := TRUE ;
  1592. Entry := '           ' ;
  1593. __COffScn (FALSE) ;
  1594. __CSizeScn (Top,Bottom) ;
  1595. While Continue DO
  1596.       BEGIN
  1597.       Read (KBD,Ch) ;
  1598.       KeyCheck ;
  1599.       CASE Key OF
  1600.            Regular : BEGIN
  1601.                      Write (Ch) ;
  1602.                      Entry[Pos] := Ch ;
  1603.                      IF Pos < 12
  1604.                         THEN Pos := Pos + 1
  1605.                         ELSE GotoXY(X+Pos,10) ;
  1606.                      END ;
  1607.             Return : IF Entry[1] = #32
  1608.                         THEN BEGIN
  1609.                              DataIn ; Continue := FALSE ;
  1610.                              END
  1611.                         ELSE BEGIN
  1612.                              DataFile := Entry ;
  1613.                              UpString (DataFile) ;
  1614.                              DataIn ; IF LoadFailed THEN GOTO 1 ;
  1615.                              Continue := FALSE ;
  1616.                              END ;
  1617.          BackSpace : IF Pos > 1
  1618.                         THEN BEGIN
  1619.                              Pos := Pos - 1 ;
  1620.                              GotoXY(X+Pos,10) ;
  1621.                              Entry[Pos] := #32 ;
  1622.                              Write (Entry[Pos]) ;
  1623.                              GotoXY(X+Pos,10) ;
  1624.                              END ;
  1625.             Cursor : CASE CursorDir OF
  1626.                           Left : BEGIN
  1627.                                  IF Pos > 1 THEN
  1628.                                     BEGIN
  1629.                                     Pos := Pos - 1 ;
  1630.                                     GotoXY(X+Pos,10) ;
  1631.                                     END ;
  1632.                                  END ;
  1633.                          Right : BEGIN
  1634.                                  IF Pos < 12 THEN
  1635.                                     BEGIN
  1636.                                     Pos := Pos + 1 ;
  1637.                                     GotoXY(X+Pos,10) ;
  1638.                                     END ;
  1639.                                  END ;
  1640.                            END ;
  1641.                  F1 : BEGIN
  1642.                       InitialConfig := TRUE ;
  1643.                       DataIn ;
  1644.                       Continue := FALSE ;
  1645.                       END ;
  1646.              Escape : BEGIN Abort := TRUE ; Continue := FALSE ; END ;
  1647.            END ;       (* end case key            *)
  1648.       END ;            (* end while continue      *)
  1649. 1 : __COffScn (TRUE) ;
  1650. END ;                  (* end procedure opening screen *)
  1651.  
  1652. (************************************************************************)
  1653.  
  1654.  PROCEDURE Cardex ;
  1655.  
  1656. BEGIN
  1657. __COffScn (TRUE) ;
  1658. Screen ;
  1659. JustStarted := FALSE ;
  1660. Current := Head ;
  1661. ThisCard := Current^.Card ;
  1662. IF NOT Abort THEN DataToScreen ;
  1663. FunctionKeyInfo ;
  1664. While Abort = FALSE DO
  1665.       BEGIN
  1666.       IF EntryGotoCard THEN DoFunctionCommand ('>') ELSE
  1667.          BEGIN
  1668.          InKey := GetKey (FunctionKey) ;
  1669.          IF FunctionKey THEN DoFunctionCommand (InKey)
  1670.          ELSE CASE CharIn OF
  1671.             'M' : MarkCard     ;
  1672.             'T' : IF MarkedFile <> DataFile THEN TransferCard ;
  1673.             END ;
  1674.          IF InKey = #27 THEN Abort := TRUE ;
  1675.          END ;
  1676.       END ;
  1677. END ;
  1678.  
  1679. (************************************************************************)
  1680.  
  1681. PROCEDURE SetCoordinates ;
  1682.  
  1683. VAR Pos : INTEGER ;
  1684.  
  1685. BEGIN
  1686. FOR FldNbr := 1 TO 5 DO Fld[FldNbr].Y := 1 ;
  1687. Fld[1].X := 1 ; Fld[2].X := 20 ; Fld[3].X := 41 ;
  1688. Fld[4].X := 46 ; Fld[5].X := 50 ;
  1689. Fld[6].X := 1 ; Fld[6].Y := 2 ;
  1690. FOR FldNbr := 7 TO 10 DO Fld[FldNbr].Y := 3 ;
  1691. Fld[7].X := 1 ; Fld[8].X := 28 ; Fld[9].X := 31 ; Fld[10].X := 37 ;
  1692. Fld[1].Len := 19 ; Fld[2].Len  := 15 ;
  1693. Fld[3].Len := 3  ; Fld[4].Len  := 3  ;
  1694. Fld[5].Len := 4  ; Fld[6].Len  := 54 ;
  1695. Fld[7].Len := 26 ; Fld[8].Len  := 2  ;
  1696. Fld[9].Len := 5  ; Fld[10].Len := 4  ;
  1697. FOR FldNbr := 11 TO 15 DO
  1698.     BEGIN
  1699.     Fld[FldNbr].X := 1 ; Fld[FldNbr].Y := FldNbr - 6 ;
  1700.     Fld[FldNbr].Len := 54 ;
  1701.     END ;
  1702. FOR FldNbr := 1 TO 15 DO
  1703.     FOR Pos := 1 TO Fld[FldNbr].Len DO Fld[FldNbr].Str[Pos] := #32 ;
  1704. TempFld := Fld ;
  1705. Prompt[1]  := '( Last name )'                  ;
  1706. Prompt[2]  := '( First name )'                 ;
  1707. Prompt[3]  := '( Area code )'                  ;
  1708. Prompt[4]  := '( Phone exchange - 3 digits )'  ;
  1709. Prompt[5]  := '( Phone - last 4 digits ) '     ;
  1710. Prompt[6]  := '( Street address or P.O. Box )' ;
  1711. Prompt[7]  := '( City )'                       ;
  1712. Prompt[8]  := '( State - 2 letter code )'      ;
  1713. Prompt[9]  := '( ZIP - 5 digits )'             ;
  1714. Prompt[10] := '( Extended ZIP - 4 digits )'    ;
  1715. FOR Counter := 11 TO 15 DO
  1716.     Prompt[Counter] := '( Additional information )' ;
  1717. END ;
  1718.  
  1719. (************************************************************************)
  1720.  
  1721. PROCEDURE BuildCopyRight ;
  1722.  
  1723. BEGIN
  1724. Copyright := '                            ' ;
  1725. Copyrite[1]  := 67  ; Copyrite[16]  := 32  ; Copyrite[25]  := 115 ;
  1726. Copyrite[2]  := 111 ; Copyrite[17]  := 77  ; Copyrite[26]  := 111 ;
  1727. Copyrite[3]  := 112 ; Copyrite[18]  := 97  ; Copyrite[27]  := 110 ;
  1728. Copyrite[4]  := 121 ; Copyrite[19]  := 114 ; Copyrite[10]  := 32  ;
  1729. Copyrite[5]  := 114 ; Copyrite[20]  := 107 ; Copyrite[11]  := 49  ;
  1730. Copyrite[6]  := 105 ; Copyrite[21]  := 32  ; Copyrite[12]  := 57  ;
  1731. Copyrite[7]  := 103 ; Copyrite[22]  := 67  ; Copyrite[13]  := 56  ;
  1732. Copyrite[8]  := 104 ; Copyrite[23]  := 97  ; Copyrite[14]  := 54  ;
  1733. Copyrite[9]  := 116 ; Copyrite[24]  := 114 ;
  1734. Copyrite[15] := 44 ;
  1735. FOR Pos := 1 TO 27 DO
  1736.     Copyright[Pos] := CHR (Copyrite[Pos]) ;
  1737. END;
  1738.  
  1739. (******************** START OF MAIN CONTROL ROUTINE *********************)
  1740.  
  1741. BEGIN
  1742. Top := 6 ; Bottom := 7 ;
  1743. __COffScn (TRUE) ;
  1744. BuildCopyright ;
  1745. IF ParamCount >= 2
  1746.    THEN EntryGotoCard := TRUE
  1747.    ELSE EntryGotoCard := FALSE ;
  1748. Abort := FALSE ;
  1749. Changed := FALSE ;
  1750. LoadFailed := FALSE ;
  1751. JustStarted := TRUE ;
  1752. InitialConfig := FALSE ;
  1753. Monitor := 'M' ; DefaultArea := '808' ; FormFeed := 'N' ; Access := '1-' ;
  1754. DataFile := 'CARDEX.DAT' ; DiskFile := '' ;
  1755. InfoLine := ' '+CHR(18)+' NEXT/PREV   PgUp/PgDn ADV/BACK 4   Home FIRST CARD   End NEW FILE  Esc EXIT ' ;
  1756. TextBackground (Black) ;
  1757. ClrScr ;
  1758. AuthorsCard ;
  1759. ReadConfiguration ;
  1760. SetCoordinates ;
  1761. OpeningScreen ;
  1762. IF InitialConfig THEN Configure ;
  1763. IF LoadFailed THEN Abort := TRUE ;
  1764. IF NOT Abort THEN
  1765.    BEGIN
  1766.    Cardex ;
  1767.    IF Changed = TRUE THEN SaveToDisk ;
  1768.    END ;
  1769. TextBackGround (Black) ; TextColor ( White) ;
  1770. ClrScr ; TextColor (Black) ; TextBackGround (Black) ; GotoXY (1,1) ;
  1771. Write ('CARDEX ',Copyright) ;
  1772. Write ('- Compiled ',CompileDate) ;
  1773. TextColor (White) ;
  1774. __COffScn (FALSE) ;
  1775. __CSizeScn (Top,Bottom) ;
  1776. END. (* END OF PROGRAM *)
  1777.  
  1778. (*********************** END OF PROGRAM "CARDEX" ************************)
  1779.